home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Deutsche Edition 1
/
Deutsche Edition 1.iso
/
amok
/
031-040
/
amok32
/
billard
/
billard.mod
< prev
next >
Wrap
Text File
|
1993-11-04
|
43KB
|
1,336 lines
(*********************************************************************
:Program. Billard
:Contents. Billard-Simulation (Game)
:Author. Stefan Salewski
:Copyright. Shareware
:Language. Modula-2
:Translator. M2Amiga AMSoft V3.3d
:History. V1.0 16.Dec.1989
:Address. Stolper Weg 3, D-2160 Stade
:Imports. ILBMHandler,TurboFiles,Assembler2 (* my own *)
:Imports. MemSystem (* Autor: Nicolas Benezan *)
*********************************************************************)
MODULE Billard;
FROM MemSystem IMPORT NoCareAllocMem;
FROM ILBMHandler IMPORT InitScreen,ReadInfo,ReadBody,ILBMInfo,
MaskPlane,DimOn,DimOff,MakeBitMap,FreeBitMap;
FROM BillardSound IMPORT ballSound0Ptr,ballSound1Ptr,
borderSoundPtr,holeSoundPtr,Beep;
FROM Arts IMPORT Assert,TermProcedure,Requester;
FROM RandomNumber IMPORT PutSeed,RND;
FROM MathTrans IMPORT Sqrt,Fieee;
FROM SYSTEM IMPORT ADR,ADDRESS,CAST,BITSET,FFP,LONGSET;
FROM Exec IMPORT MemReqSet,MemReqs,Interrupt,AddIntServer,
RemIntServer,NodeType,WaitPort,GetMsg,ReplyMsg;
FROM ExecSupport IMPORT BeginIO,AbortIO;
FROM Dos IMPORT Delay;
FROM Hardware IMPORT IntFlags;
FROM Assembler2 IMPORT MaxInt,MinInt;
FROM Intuition IMPORT ScreenPtr,customScreen,ViewAddress,NewScreen,
OpenScreen,CloseScreen,ScreenToBack,menuDown,
MakeScreen,RethinkDisplay,ScreenFlagSet,ScreenFlags,
ScreenToFront,NewWindow,WindowPtr,IDCMPFlags,IDCMPFlagSet,
WindowFlags,WindowFlagSet,OpenWindow,CloseWindow,IntuiMessagePtr,
ModifyIDCMP,selectDown,Gadget,ActivationFlagSet,ActivationFlags,
GadgetFlags,GadgetFlagSet,boolGadget,AddGList,RemoveGList,
GadgetPtr,AddGadget,RemoveGadget,CurrentTime,SetPointer;
FROM GfxMacros IMPORT RemBob;
FROM Graphics IMPORT RastPortPtr,VSprite,VSpriteFlags,VSpriteFlagSet,
ViewModes,ViewModeSet,InitGels,AddVSprite,RemVSprite,GelsInfo,
SortGList,DrawGList,Text,jam2,SetBPen,
InitMasks,VSpritePtr,SetRGB4,AddBob,
Bob,BobFlagSet,SetRast,SetAPen,RectFill,InitBitMap,
RastPortFlags,DBufPacket,FreeRaster,BitMap,BltClear,BltBitMap,
BitMapPtr,Move,Draw,SetDrMd,DrawModes,DrawModeSet;
CONST
(*
SaveAllRegs = INLINE(048E7H,0FFFEH); MOVEM.L D0-A6,-(A7)
SaveRegs = INLINE(048E7H,03F3EH); MOVEM.L D2-D7/A2-A6,-(A7)
LoadAllRegs = INLINE(04CDFH,07FFFH); MOVEM.L (A7)+,D0-A6
LoadRegs = INLINE(04CDFH,07CFCH); MOMEM.L (A7)+,D2-D7/A2-A6
*)
BitsPerByte=8;
PictureName='BillardTable';
ScreenHeight=256;
ScreenWidth=320;
ScreenDepth=5;
BallImageX=24; (* Position of the Balls in the picture *)
BallImageY=176;
BallImageYDigi=136;
BallImageDis=20;
MaxGels=16;
GadgetHeight=20;
MaxGadgets=13;
BobHeight=16;
BobWidth=2; (* Bytes *)
MaxVol=64;
Frame=22; (* The width of the wood-frame *)
MaxPixelPerSec=140.0;
IntPerSec=50.0; (* VBlank Interupts per second *)
HoleDiameter=19;
GroundC=1;(* ColorNumbers *)
HoleC=2;
FrameC=3;
InfoC=4;
TextC=5;
TextBorderC=6;
TextBGC=7;
FirstBallC=16;
LocEx=64; (* Tranformation to use the whole Integer-Range *)
TimeEx=50.0; (* Time-Transformation *)
MinX=0;
MaxX=ScreenWidth*LocEx;
MinY=0;
MaxY=(ScreenHeight-GadgetHeight)*LocEx;
BallDiameter=(BobWidth*8-1)*LocEx; (* one Pixel shadow *)
BallRadius=BallDiameter DIV 2;
DeltaEdge=4*LocEx; (* Difficulty of Play = HoleSize *)
DeltaMiddle=7*LocEx;
MaxStickLen=120;
Border=Frame*LocEx+BallRadius;
BobMemory=BobWidth*BobHeight*ScreenDepth;
LeftMost=Border;
RightMost=MaxX-Border;
MiddleX=MaxX DIV 2;
TopMost=Border;
BottomMost=MaxY-Border;
Tick=1.0/IntPerSec*TimeEx;
Power=3;
VMax=MaxPixelPerSec/TimeEx*FFP(LocEx);
Tuck=FFP(BallRadius)/VMax;
MaxTravels=1;
Xex=(ScreenWidth-2*Frame-BallDiameter DIV LocEx)*MaxTravels;
R=MaxPixelPerSec*MaxPixelPerSec/(2.0*FFP(Xex));
Friction=R/(TimeEx*TimeEx)*FFP(LocEx);
Tag=0;
CustomBM=ScreenFlagSet{customBitMap,screenBehind};
IDCMP=IDCMPFlagSet{gadgetUp,mouseButtons};
TYPE
SpecialDates=RECORD
id:CARDINAL; (* identification-Number of this Sprite *)
on:BOOLEAN; (* True: This Ball is on the table *)
x,y:FFP; (* current location in FFP *)
xi,yi:INTEGER; (* current location in Integer *)
x0,y0:FFP; (* start loc. from upper left corner *)
v0x,v0y:FFP; (* velocity for x- y-direction *)
v:FFP; (* velocity=SQRT(v0x*v0x + v0y*v0y) *)
t:FFP; (* elapsed time *)
tex:FFP; (* at this time speed of the ball is zero *)
rx,ry:FFP;
inHole:INTEGER;(* in which hole is the ball?(0: on table) *)
borderCols:INTEGER; (* how often hit the ball the border *)
ballCols:BITSET; (* which other balls did this ball hit *)
END;
ExtVSprite=RECORD
vSprite:VSprite;
bob:Bob;
dBufPacket:DBufPacket;
special:SpecialDates;
END;
ExtVSpritePtr=POINTER TO ExtVSprite;
Plane=ARRAY[0..7] OF LONGCARD;
BobSpace=RECORD
planes:ARRAY[0..4] OF Plane;
END;
BobDatas=ARRAY[1..MaxGels] OF BobSpace;
String3=ARRAY[0..3-1] OF CHAR;
VAR
gadget:ARRAY[1..MaxGadgets] OF Gadget;
gadgetXPos:ARRAY[1..MaxGadgets] OF RECORD
x1,x2:INTEGER
END;
controlInterrupt:Interrupt;
bitMapPtr:ARRAY[0..1] OF BitMapPtr;
bobDataPtr:POINTER TO BobDatas;
pointerPtr:POINTER TO ARRAY[0..21] OF CARDINAL;
tag:[0..1];
screenPtr:ScreenPtr;
windowPtr:WindowPtr;
bodyPos:LONGINT;
picInfo:ILBMInfo;
picName:ARRAY[0..32] OF CHAR;
vSprite1,vSprite2:VSprite;
sprite:ARRAY[1..MaxGels] OF ExtVSprite;
undoPos:ARRAY[1..MaxGels] OF RECORD
on:BOOLEAN;
x,y:FFP;
END;
spritei,spritej:ExtVSpritePtr;
gelsInfo:GelsInfo;
iii,jjj:CARDINAL; (* reserved for Control *)
vol,vol1,vol2:FFP;(* sound-volume *)
square,dx,dy:LONGINT;
tDiv2:FFP;
vix,viy,vjx,vjy:FFP;
ddx,ddy:LONGINT;
dddx,dddy:FFP;
lambda:FFP;
controlOn:BOOLEAN;
noBallMoved:BOOLEAN;
ballsOnTable:INTEGER;
points:ARRAY [0..1] OF INTEGER;
undoPoints:ARRAY [0..1] OF INTEGER;
hits:INTEGER;
undoHits:INTEGER;
spriteCount:INTEGER;
maxTravels:INTEGER;
friction:FFP;
power:BOOLEAN;
digi:BOOLEAN;
pool:BOOLEAN;
player:[0..1];
undoPlayer:[0..1];
integer:INTEGER;
(***************************************************************************)
PROCEDURE IntToStr(i:INTEGER;VAR str:String3);
BEGIN
str[0]:=CHAR(((i DIV 10) MOD 10)+INTEGER('0'));
str[1]:=CHAR((i MOD 10)+INTEGER('0'));
str[2]:=0C;
END IntToStr;
(***************************************************************************)
PROCEDURE ExtractBalls(source:BitMapPtr);
VAR
bm:BitMap;
j,k:INTEGER;
y:INTEGER;
BEGIN
IF digi THEN
y:=BallImageYDigi
ELSE
y:=BallImageY
END;
InitBitMap(bm,ScreenDepth,BobWidth*BitsPerByte,BobHeight);
FOR j:=1 TO MaxGels DO
FOR k:=0 TO ScreenDepth-1 DO
bm.planes[k]:=ADR(bobDataPtr^[j].planes[k]);
END;
integer:=BltBitMap(source,BallImageX+((j-1) MOD 8)*BallImageDis,
y+((j-1) DIV 8)*BallImageDis,
ADR(bm),0,0,BobHeight,BobHeight,0C0H,255,NIL);
END;
END ExtractBalls;
(*********-******************************************************************)
(* This is a interrupt-procedure, so we have to prevent registers from *)
(* changes. Instead of t- we can use INLINE() or SYSTEM.SAVEREGS *)
(* $t- This is a new 3.3-option to save and restore registers *)
(* $S- turning off Stackcheck is necessary *)
(* $R-$V-$N-$F- this is only for more speed *)
PROCEDURE Control;
BEGIN
noBallMoved:=TRUE;
iii:=spriteCount;
spritei:=ADR(sprite);
REPEAT
IF spritei^.special.on THEN
WITH spritei^.special DO
t:=t+Tick;
IF t<=tex THEN
noBallMoved:=FALSE;
(*tDiv2:=t*0.5;*)
(* FFP: x:=x/2.0 <===> DEC(CAST(LONGINT,x)) *)
tDiv2:=CAST(FFP,CAST(LONGINT,t)-1);
x:=x0+t*(v0x-rx*tDiv2);
xi:=INTEGER(x);
y:=y0+t*(v0y-ry*tDiv2);
yi:=INTEGER(y);
(* FFP: (7 IN CAST(LONGSET,x)) <===> (x<0.0) *)
IF ((xi<=LeftMost) AND (7 IN CAST(LONGSET,v0x)))
OR ((xi>=RightMost) AND NOT (7 IN CAST(LONGSET,v0x))) THEN
IF pool AND ((yi<TopMost+DeltaEdge) OR
(yi>BottomMost-DeltaEdge)) THEN
IF ((xi<=LeftMost-BallRadius))
OR ((xi>=RightMost+BallRadius)) THEN
on:=FALSE;
RemBob(ADR(spritei^.bob));
DEC(ballsOnTable);
INC(points[player],id);
(*Beep(holeSoundPtr,64);*)
IF holeSoundPtr#NIL THEN
holeSoundPtr^.volume:=MaxVol;
AbortIO(holeSoundPtr);
BeginIO(holeSoundPtr);
END
END
ELSE
x0:=x;
y0:=y;
v0x:=-v0x+rx*t;
v0y:=v0y-ry*t;
vol:=ABS(v0x)/(VMax/FFP(MaxVol));
(*Beep(borderSoundPtr,INTEGER(vol));*)
IF borderSoundPtr#NIL THEN
borderSoundPtr^.volume:=INTEGER(vol);
AbortIO(borderSoundPtr);
BeginIO(borderSoundPtr);
END;
v:=Sqrt(v0x*v0x+v0y*v0y);
tex:=v/friction;
IF v#0.0 THEN
rx:=v0x/tex;
ry:=v0y/tex;
END;
t:=0.0;
END;
END;
IF on AND(((yi<=TopMost) AND (7 IN CAST(LONGSET,v0y)))
OR ((yi>=BottomMost) AND NOT (7 IN CAST(LONGSET,v0y)))) THEN
IF pool AND ((xi<LeftMost+DeltaEdge) OR
(xi>RightMost-DeltaEdge) OR
((xi>MiddleX-DeltaMiddle) AND
(xi<MiddleX+DeltaMiddle))) THEN
IF (yi<=TopMost-BallRadius)
OR (yi>=BottomMost+BallRadius) THEN
on:=FALSE;
RemBob(ADR(spritei^.bob));
DEC(ballsOnTable);
INC(points[player],id);
(*Beep(holeSoundPtr,64);*)
IF holeSoundPtr#NIL THEN
holeSoundPtr^.volume:=MaxVol;
AbortIO(holeSoundPtr);
BeginIO(holeSoundPtr);
END;
END;
ELSE
x0:=x;
y0:=y;
v0y:=-v0y+ry*t;
v0x:=v0x-rx*t;
vol:=ABS(v0y)/(VMax/FFP(MaxVol));
(*Beep(borderSoundPtr,INTEGER(vol));*)
IF borderSoundPtr#NIL THEN
borderSoundPtr^.volume:=INTEGER(vol);
AbortIO(borderSoundPtr);
BeginIO(borderSoundPtr);
END;
v:=Sqrt(v0x*v0x+v0y*v0y);
tex:=v/friction;
IF v#0.0 THEN
rx:=v0x/tex;
ry:=v0y/tex;
END;
t:=0.0;
END;
END;
END;
END;
END;
INC(spritei,SIZE(ExtVSprite));
DEC(iii);
UNTIL iii=0;
iii:=spriteCount-1;
spritei:=ADR(sprite);
REPEAT
IF spritei^.special.on THEN
spritej:=spritei;
jjj:=iii;
REPEAT
INC(spritej,SIZE(ExtVSprite));
IF spritej^.special.on THEN
ddx:=spritei^.special.xi-spritej^.special.xi;
ddy:=spritei^.special.yi-spritej^.special.yi;
IF (ABS(ddx)<=BallDiameter) AND (ABS(ddy)<=BallDiameter) THEN
square:=ddx*ddx+ddy*ddy;
IF square<=BallDiameter*BallDiameter THEN
WITH spritei^.special DO
IF t<=tex THEN
vix:=v0x-rx*t;
viy:=v0y-ry*t;
ELSE
vix:=0.0;
viy:=0.0;
END;
END;
WITH spritej^.special DO
IF t<=tex THEN
vjx:=v0x-rx*t;
vjy:=v0y-ry*t;
ELSE
vjx:=0.0;
vjy:=0.0;
END;
END;
dx:=ddx+LONGINT(Tuck*(vix-vjx));
dy:=ddy+LONGINT(Tuck*(viy-vjy));
IF dx*dx+dy*dy<square THEN
WITH spritei^.special DO
x0:=x;
y0:=y;
v0x:=vix;
v0y:=viy;
END;
WITH spritej^.special DO
x0:=x;
y0:=y;
v0x:=vjx;
v0y:=vjy;
END;
dddx:=spritei^.special.x-spritej^.special.x;
dddy:=spritei^.special.y-spritej^.special.y;
lambda:=dddx*(spritej^.special.v0x-spritei^.special.v0x);
lambda:=lambda+dddy*(spritej^.special.v0y-
spritei^.special.v0y);
lambda:=lambda/(dddx*dddx+dddy*dddy);
vol1:=lambda*dddx;
spritei^.special.v0x:=spritei^.special.v0x+vol1;
spritej^.special.v0x:=spritej^.special.v0x-vol1;
vol2:=lambda*dddy;
spritei^.special.v0y:=spritei^.special.v0y+vol2;
spritej^.special.v0y:=spritej^.special.v0y-vol2;
WITH spritei^.special DO
v:=Sqrt(v0x*v0x+v0y*v0y);
tex:=v/friction;
IF v#0.0 THEN
rx:=v0x/tex;
ry:=v0y/tex;
END;
t:=0.0;
END;
WITH spritej^.special DO
v:=Sqrt(v0x*v0x+v0y*v0y);
tex:=v/friction;
IF v#0.0 THEN
rx:=v0x/tex;
ry:=v0y/tex;
END;
t:=0.0;
END;
vol:=Sqrt(vol1*vol1+vol2*vol2)/(VMax/FFP(MaxVol));
(*Beep(ballSound0Ptr,INTEGER(vol));
Beep(ballSound1Ptr,INTEGER(vol));*)
IF ballSound0Ptr#NIL THEN
ballSound0Ptr^.volume:=INTEGER(vol);
AbortIO(ballSound0Ptr);
BeginIO(ballSound0Ptr);
END;
IF ballSound1Ptr#NIL THEN
ballSound1Ptr^.volume:=INTEGER(vol);
AbortIO(ballSound1Ptr);
BeginIO(ballSound1Ptr);
END;
END;
END;
END;
END;
DEC(jjj);
UNTIL jjj=0;
END;
DEC(iii);
INC(spritei,SIZE(ExtVSprite));
UNTIL iii=0;
END Control;
(* $S= *)
(* $R=$V=$N=$F=*)
(* $t= *)
(***************************************************************************)
PROCEDURE StartControl;
BEGIN
Assert(NOT controlOn,ADR('AddIntServer a second time'));
controlOn:=TRUE;
WITH controlInterrupt DO
node.type:=interrupt;
node.pri:=-60;
node.name:=ADR('BillardInterrupt');
data:=NIL;
code:=ADR(Control);
END;
(* SETREG(0,0); Only for V3.2 , Compiler-ERROR !!! *)
AddIntServer(LONGINT(vertb),ADR(controlInterrupt));
END StartControl;
(***************************************************************************)
PROCEDURE EndControl;
BEGIN
Assert(controlOn,ADR('RemIntServer a second time'));
controlOn:=FALSE;
(* SETREG(0,0); Only for V3.2 , Compiler-ERROR !!! *)
RemIntServer(LONGINT(vertb),ADR(controlInterrupt));
END EndControl;
(***************************************************************************)
PROCEDURE CleanUp;
VAR
i:INTEGER;
BEGIN
(*IF CurrentLevel()<=startLevel THEN only for Compiler V3.2 *)
IF controlOn THEN
EndControl
END;
FOR i:=1 TO MaxGels DO
IF sprite[i].special.on THEN
RemBob(ADR(sprite[i].bob))
END;
END;
IF windowPtr#NIL THEN
CloseWindow(windowPtr)
END;
IF screenPtr#NIL THEN
CloseScreen(screenPtr)
END;
FreeBitMap(bitMapPtr[0]);
FreeBitMap(bitMapPtr[1]);
END CleanUp;
(***************************************************************************)
PROCEDURE InitGadgets;
VAR
i:INTEGER;
BEGIN
gadgetXPos[1].x1:=02; gadgetXPos[1].x2:=34;
gadgetXPos[2].x1:=37; gadgetXPos[2].x2:=61;
gadgetXPos[3].x1:=63; gadgetXPos[3].x2:=72;
gadgetXPos[4].x1:=74; gadgetXPos[4].x2:=83;
gadgetXPos[5].x1:=85; gadgetXPos[5].x2:=102;
gadgetXPos[6].x1:=104; gadgetXPos[6].x2:=121;
gadgetXPos[7].x1:=123; gadgetXPos[7].x2:=150;
gadgetXPos[8].x1:=153; gadgetXPos[8].x2:=163;
gadgetXPos[9].x1:=166; gadgetXPos[9].x2:=181;
gadgetXPos[10].x1:=191;gadgetXPos[10].x2:=207;
gadgetXPos[11].x1:=210;gadgetXPos[11].x2:=243;
gadgetXPos[12].x1:=246;gadgetXPos[12].x2:=279;
gadgetXPos[13].x1:=282;gadgetXPos[13].x2:=317;
FOR i:=1 TO MaxGadgets DO
WITH gadget[i] DO
IF i<MaxGadgets THEN
nextGadget:=ADR(gadget[i+1])
ELSE
nextGadget:=NIL
END;
leftEdge:=gadgetXPos[i].x1+1;
topEdge:=ScreenHeight-GadgetHeight;
width:=gadgetXPos[i].x2-gadgetXPos[i].x1;
height:=GadgetHeight;
flags:=GadgetFlagSet{};
activation:=ActivationFlagSet{relVerify};
gadgetType:=boolGadget;
gadgetRender:=NIL;
selectRender:=NIL;
gadgetText:=NIL;
mutualExclude:=LONGSET{};
specialInfo:=NIL;
gadgetID:=i;
userData:=NIL;
END;
END;
INCL(gadget[8].activation,toggleSelect);
INCL(gadget[2].activation,toggleSelect);
END InitGadgets;
(***************************************************************************)
PROCEDURE PlaceBall(num:CARDINAL;xx,yy,v0xx,v0yy:FFP);
BEGIN
WITH sprite[num].special DO
on:=TRUE;
borderCols:=0;
ballCols:={};
t:=0.0;
x0:=xx;
x:=xx;
y0:=yy;
y:=yy;
xi:=INTEGER(xx);
yi:=INTEGER(yy);
v0x:=v0xx;
v0y:=v0yy;
v:=Sqrt(v0xx*v0xx+v0yy*v0yy);
tex:=v/friction;
IF v#0.0 THEN
rx:=v0xx/tex;
ry:=v0yy/tex;
END;
END;
END PlaceBall;
(***************************************************************************)
PROCEDURE FindNextBall(x,y:INTEGER):INTEGER;
VAR
i,next:INTEGER;
dx,dy,d,h:LONGINT;
BEGIN
d:=MAX(LONGINT);
next:=0;
FOR i:=1 TO spriteCount DO
IF sprite[i].special.on THEN
dx:=LONGINT(sprite[i].special.xi-x*LocEx);
dy:=LONGINT(sprite[i].special.yi-y*LocEx);
h:=dx*dx+dy*dy;
IF h<d THEN
d:=h;
next:=i
END;
END;
END;
RETURN next;
END FindNextBall;
(***************************************************************************)
PROCEDURE SetBall(i:INTEGER);
VAR
x1,x2,y1,y2,oldX,oldY:INTEGER;
dx,dy:LONGINT;
intuiMessagePtr:IntuiMessagePtr;
class:IDCMPFlagSet;
code:CARDINAL;
maxStickLen,d:LONGINT;
BEGIN
IF power THEN
maxStickLen:=MaxStickLen DIV Power
ELSE
maxStickLen:=MaxStickLen
END;
INC(hits);
d:=maxStickLen*maxStickLen;
SetDrMd(ADR(screenPtr^.rastPort),DrawModeSet{complement});
x1:=sprite[i].special.xi DIV LocEx;
y1:=sprite[i].special.yi DIV LocEx;
oldX:=x1;
oldY:=y1;
ModifyIDCMP(windowPtr,IDCMPFlagSet{mouseMove,mouseButtons});
Move(ADR(screenPtr^.rastPort),x1,y1);
Draw(ADR(screenPtr^.rastPort),x1,y1);
REPEAT
WaitPort(windowPtr^.userPort);
intuiMessagePtr:=GetMsg(windowPtr^.userPort);
class:=intuiMessagePtr^.class;
code:=intuiMessagePtr^.code;
x2:=intuiMessagePtr^.mouseX;
y2:=intuiMessagePtr^.mouseY;
ReplyMsg(intuiMessagePtr);
dx:=x1-x2;
dy:=y1-y2;
IF (dx*dx+dy*dy)<=d THEN
Move(ADR(screenPtr^.rastPort),x1,y1);
Draw(ADR(screenPtr^.rastPort),oldX,oldY);
Move(ADR(screenPtr^.rastPort),x1,y1);
Draw(ADR(screenPtr^.rastPort),x2,y2);
oldX:=x2;
oldY:=y2;
END;
UNTIL (mouseButtons IN class) AND (code=selectDown);
Move(ADR(screenPtr^.rastPort),x1,y1);
Draw(ADR(screenPtr^.rastPort),oldX,oldY);
PlaceBall(i,sprite[i].special.x,sprite[i].special.y,
FFP(x1-oldX)/FFP(maxStickLen)*VMax,
FFP(y1-oldY)/FFP(maxStickLen)*VMax);
ModifyIDCMP(windowPtr,IDCMP);
END SetBall;
(***************************************************************************)
PROCEDURE InitBalls;
VAR
num:CARDINAL;
BEGIN
FOR num:=1 TO MaxGels DO
WITH sprite[num].special DO
id:=num-1;
on:=FALSE;
x:=0.0;
y:=0.0;
t:=0.0;
x0:=0.0;
y0:=0.0;
xi:=0;
yi:=0;
v0x:=0.0;
v0y:=0.0;
v:=0.0;
tex:=0.0;
rx:=0.0;
ry:=0.0;
inHole:=0;
borderCols:=0;
ballCols:={};
END;
WITH sprite[num].vSprite DO
nextVSprite := NIL;
prevVSprite := NIL;
drawPath := NIL;
clearPath := NIL;
oldY := 0;
oldX := 0;
flags:=VSpriteFlagSet{overlay,saveBack};
x:=0;
y:=0;
height:=BobHeight;
width:=BobWidth DIV 2; (* width means the width in WORDS !!! *)
depth:=ScreenDepth;
meMask:={};
hitMask:={};
imageData:=ADR(bobDataPtr^[num]);
NoCareAllocMem(borderLine,BobWidth,TRUE);
NoCareAllocMem(collMask,BobWidth*BobHeight,TRUE);
sprColors:=NIL;
vsBob:=ADR(sprite[num].bob);
planePick:=255;
planeOnOff :=0;
END;
WITH sprite[num].dBufPacket DO
bufY:=0;
bufX:=0;
bufPath:=NIL;
NoCareAllocMem(bufBuffer,BobWidth*BobHeight*ScreenDepth,TRUE);
END;
WITH sprite[num].bob DO
flags:=BobFlagSet{};
NoCareAllocMem(saveBuffer,BobWidth*BobHeight*ScreenDepth,TRUE);
imageShadow:=sprite[num].vSprite.collMask;
before:=NIL;
after:=NIL;
bobVSprite:=ADR(sprite[num].vSprite);
bobComp:=NIL;
dBuffer:=ADR(sprite[num].dBufPacket);
END;
InitMasks(ADR(sprite[num]));
END;
END InitBalls;
(***************************************************************************)
PROCEDURE InitAll;
VAR
newScreen:NewScreen;
newWindow:NewWindow;
i:INTEGER;
BEGIN
tag:=Tag;
screenPtr:=NIL;
windowPtr:=NIL;
bitMapPtr[0]:=NIL;
bitMapPtr[1]:=NIL;
bobDataPtr:=NIL;
controlOn:=FALSE;
noBallMoved:=FALSE;
FOR i:=1 TO MaxGels DO
sprite[i].special.on:=FALSE;
END;
TermProcedure(CleanUp);
NoCareAllocMem(bobDataPtr,SIZE(BobDatas),TRUE);
NoCareAllocMem(pointerPtr,SIZE(pointerPtr^),TRUE);
FOR i:=0 TO 21 DO
IF ODD(i) THEN
pointerPtr^[i]:=0
ELSE
pointerPtr^[i]:=256
END
END;
pointerPtr^[0]:=0;
pointerPtr^[10]:=7920;
pointerPtr^[20]:=0;
player:=0;
pool:=TRUE;
power:=FALSE;
digi:=FALSE;
spriteCount:=7;
maxTravels:=2;
friction:=Friction/FFP(maxTravels);
ballsOnTable:=spriteCount;
hits:=0;
undoHits:=0;
points[0]:=0;
points[1]:=0;
undoPoints[0]:=0;
undoPoints[1]:=0;
WITH gelsInfo DO
sprRsrvd:=0;
flags:=0;
gelHead:=NIL;
gelTail:=NIL;
nextLine:=NIL;
lastColor:=NIL;
collHandler:=NIL;
leftmost:=0;
rightmost:=ScreenWidth;
topmost:=0;
bottommost:=ScreenHeight;
firstBlissObj:=NIL;
lastBlissObj:=NIL;
END;
InitGels(ADR(vSprite1),ADR(vSprite2),ADR(gelsInfo));
InitGadgets;
bitMapPtr[0]:=MakeBitMap(ScreenWidth,ScreenHeight,ScreenDepth);
Assert(bitMapPtr[0]#NIL,ADR('Not enough Chip-Memory for BitMaps'));
bitMapPtr[1]:=MakeBitMap(ScreenWidth,ScreenHeight,ScreenDepth);
Assert(bitMapPtr[1]#NIL,ADR('Not enough Chip-Memory for BitMaps'));
picName:=PictureName;
Assert(ReadInfo(picName,picInfo,bodyPos),ADR('Picture not found'));
InitScreen(newScreen,picInfo,FALSE);
newScreen.type:=customScreen+CustomBM;
newScreen.customBitMap:=bitMapPtr[Tag];
screenPtr:=OpenScreen(newScreen);
Assert(screenPtr#NIL,ADR("Can't open Screen"));
WITH newWindow DO
leftEdge:=0;
topEdge:=0;
width:=newScreen.width;
height:=newScreen.height;
detailPen:=1;
blockPen:=0;
idcmpFlags:=IDCMP;
flags:=WindowFlagSet{simpleRefresh,borderless,reportMouse,
rmbTrap,activate};
firstGadget:=NIL;;
checkMark:=NIL;
title:=NIL;
screen:=screenPtr;
bitMap:=NIL;
minWidth:=newScreen.width;
minHeight:=newScreen.height;
maxWidth:=newScreen.width;
maxHeight:=newScreen.height;
type:=customScreen;
END;
windowPtr:=OpenWindow(newWindow);
Assert(windowPtr#NIL,ADR("Can't open Window"));
SetPointer(windowPtr,pointerPtr,9,16,-8,-4);
DimOff(screenPtr,picInfo,0);
Assert(ReadBody(picName,bitMapPtr[0]^,bodyPos,
picInfo.bmhd.width,
0,0,0,0,picInfo.bmhd.width,picInfo.bmhd.height,
MaskPlane(picInfo),(picInfo.bmhd.compression=1)),
ADR("Can't load Picture"));
ExtractBalls(bitMapPtr[Tag]);
InitBalls;
SetAPen(ADR(screenPtr^.rastPort),0);
RectFill(ADR(screenPtr^.rastPort),Frame,BallImageYDigi,
ScreenWidth-1-Frame,ScreenHeight-1-Frame-GadgetHeight);
ScreenToFront(screenPtr);
DimOn(screenPtr,picInfo,1);
Delay(3*50);
SetAPen(ADR(screenPtr^.rastPort),GroundC);
DimOff(screenPtr,picInfo,1);
RectFill(ADR(screenPtr^.rastPort),Frame,Frame,
ScreenWidth-1-Frame,ScreenHeight-1-Frame-GadgetHeight);
integer:=BltBitMap(bitMapPtr[0],0,0,bitMapPtr[1],0,0,ScreenWidth,
ScreenHeight,0C0H,255,NIL);
DimOn(screenPtr,picInfo,1);
(*INCL(screenPtr^.rastPort.flags,dBuffer)*);
screenPtr^.rastPort.gelsInfo:=ADR(gelsInfo);
END InitAll;
(***************************************************************************)
PROCEDURE SetDefault(balls:INTEGER);
CONST
Sqrt3=1.732;
X=FFP(INTEGER(Sqrt3*FFP(BallDiameter)/2.0/FFP(LocEx)+1.5)*LocEx);
Y=FFP(INTEGER(FFP(BallDiameter)/2.0/FFP(LocEx)+1.5)*LocEx);
VAR
i:INTEGER;
pos:ARRAY[1..MaxGels] OF RECORD
x,y:FFP;
END;
BEGIN
pos[1].x:=-5.0*X; pos[1].y:=0.0;
pos[2].x:=0.0; pos[2].y:=0.0;
pos[3].x:=X; pos[3].y:=-Y;
pos[4].x:=X; pos[4].y:=Y;
pos[5].x:=2.0*X; pos[5].y:=-2.0*Y;
pos[6].x:=2.0*X; pos[6].y:=0.0;
pos[7].x:=2.0*X; pos[7].y:=2.0*Y;
pos[8].x:=3.0*X; pos[8].y:=-3.0*Y;
pos[9].x:=3.0*X; pos[9].y:=-Y;
pos[10].x:=3.0*X; pos[10].y:=Y;
pos[11].x:=3.0*X; pos[11].y:=3.0*Y;
pos[12].x:=4.0*X; pos[12].y:=-4.0*Y;
pos[13].x:=4.0*X; pos[13].y:=-2.0*Y;
pos[14].x:=4.0*X; pos[14].y:=0.0;
pos[15].x:=4.0*X; pos[15].y:=2.0*Y;
pos[16].x:=4.0*X; pos[16].y:=4.0*Y;
FOR i:=1 TO balls DO
PlaceBall(i,FFP(MaxX DIV 2)+pos[i].x,FFP(MaxY DIV 2)+pos[i].y,0.0,0.0);
END;
END SetDefault;
(***************************************************************************)
PROCEDURE DisplayBalls;
VAR
a:INTEGER;
BEGIN
FOR a:=1 TO spriteCount DO
sprite[a].vSprite.x:=
sprite[a].special.xi DIV LocEx-BallRadius DIV LocEx;
sprite[a].vSprite.y:=
sprite[a].special.yi DIV LocEx-BallRadius DIV LocEx;
END;
tag:=1-tag;
screenPtr^.viewPort.rasInfo^.bitMap:=bitMapPtr[tag];
screenPtr^.rastPort.bitMap:=bitMapPtr[tag];
SortGList(ADR(screenPtr^.rastPort));
DrawGList(ADR(screenPtr^.rastPort),ADR(screenPtr^.viewPort));
MakeScreen(screenPtr);
RethinkDisplay();
END DisplayBalls;
(***************************************************************************)
PROCEDURE Undo;
VAR
i:INTEGER;
BEGIN
ballsOnTable:=0;
hits:=undoHits;
player:=undoPlayer;
points[0]:=undoPoints[0];
points[1]:=undoPoints[1];
FOR i:=1 TO MaxGels DO
IF undoPos[i].on THEN
INC(ballsOnTable);
IF NOT sprite[i].special.on THEN
AddBob(ADR(sprite[i].bob),ADR(screenPtr^.rastPort));
sprite[i].special.on:=TRUE;
END;
PlaceBall(i,undoPos[i].x,undoPos[i].y,0.0,0.0);
ELSE
IF sprite[i].special.on THEN
RemBob(ADR(sprite[i].bob));
sprite[i].special.on:=FALSE;
END;
END;
END;
DisplayBalls;
DisplayBalls;
END Undo;
(***************************************************************************)
PROCEDURE SaveOldPosition;
VAR
i:INTEGER;
BEGIN
undoHits:=hits;
undoPoints[0]:=points[0];
undoPoints[1]:=points[1];
undoPlayer:=player;
FOR i:=1 TO MaxGels DO
undoPos[i].on:=sprite[i].special.on;
undoPos[i].x:=sprite[i].special.x;
undoPos[i].y:=sprite[i].special.y;
END;
END SaveOldPosition;
(***************************************************************************)
PROCEDURE Info;
VAR
h,p,p0,p1,bot:String3;
i:INTEGER;
BEGIN
IntToStr(ballsOnTable,bot);
IntToStr(points[0]+points[1],p);
IntToStr(points[0],p0);
IntToStr(points[1],p1);
IntToStr(hits,h);
FOR i:=0 TO 1 DO
tag:=1-tag;
screenPtr^.viewPort.rasInfo^.bitMap:=bitMapPtr[tag];
screenPtr^.rastPort.bitMap:=bitMapPtr[tag];
SetAPen(ADR(screenPtr^.rastPort),InfoC);
SetBPen(ADR(screenPtr^.rastPort),FrameC);
SetDrMd(ADR(screenPtr^.rastPort),jam2);
Move(ADR(screenPtr^.rastPort),ScreenWidth DIV 2 +14,10);
Text(ADR(screenPtr^.rastPort),ADR(h),2);
Move(ADR(screenPtr^.rastPort),ScreenWidth DIV 2 +38,10);
Text(ADR(screenPtr^.rastPort),ADR(p0),2);
Move(ADR(screenPtr^.rastPort),ScreenWidth DIV 2 +62,10);
Text(ADR(screenPtr^.rastPort),ADR(p1),2);
Move(ADR(screenPtr^.rastPort),ScreenWidth DIV 2 +86,10);
Text(ADR(screenPtr^.rastPort),ADR(p),2);
Move(ADR(screenPtr^.rastPort),ScreenWidth DIV 2 +110,10);
Text(ADR(screenPtr^.rastPort),ADR(bot),2);
END;
END Info;
(***************************************************************************)
PROCEDURE GetMessage;
VAR
intuiMessagePtr:IntuiMessagePtr;
gadgetPtr:GadgetPtr;
code:CARDINAL;
class:IDCMPFlagSet;
i:INTEGER;
PROCEDURE MorePower;
BEGIN
power:=NOT power;
integer:=BltBitMap(bitMapPtr[tag] ,0,ScreenHeight-GadgetHeight,
bitMapPtr[1-tag],0,ScreenHeight-GadgetHeight,
ScreenWidth,GadgetHeight,0C0H,255,NIL);
END MorePower;
PROCEDURE BallNumbers;
VAR
picFound:BOOLEAN;
BEGIN
REPEAT
picFound:=ReadBody(picName,bitMapPtr[1-tag]^,bodyPos,
picInfo.bmhd.width,
BallImageX,BallImageYDigi,
BallImageX,BallImageYDigi,
8*BallImageDis,4*BallImageDis,
MaskPlane(picInfo),(picInfo.bmhd.compression=1));
IF picFound THEN
digi:=NOT digi;
ExtractBalls(bitMapPtr[1-tag]);
screenPtr^.viewPort.rasInfo^.bitMap:=bitMapPtr[1-tag];
screenPtr^.rastPort.bitMap:=bitMapPtr[1-tag];
SetAPen(ADR(screenPtr^.rastPort),GroundC);
SetBPen(ADR(screenPtr^.rastPort),GroundC);
SetDrMd(ADR(screenPtr^.rastPort),jam2);
RectFill(ADR(screenPtr^.rastPort),Frame,Frame,
ScreenWidth-1-Frame,ScreenHeight-1-Frame-GadgetHeight);
screenPtr^.viewPort.rasInfo^.bitMap:=bitMapPtr[tag];
screenPtr^.rastPort.bitMap:=bitMapPtr[tag];
DisplayBalls;
DisplayBalls;
END;
UNTIL picFound OR NOT Requester(ADR('Billard:'),
ADR("Can't find picture 'BillardTable'"),
ADR('Try again'),ADR('Cancel'));
ScreenToFront(screenPtr);
END BallNumbers;
PROCEDURE SetTriangle(n:INTEGER);
VAR
i:INTEGER;
BEGIN
SaveOldPosition;
spriteCount:=n;
ballsOnTable:=n;
points[0]:=0;
points[1]:=0;
hits:=0;
player:=0;
FOR i:=1 TO MaxGels DO
IF sprite[i].special.on THEN
RemBob(ADR(sprite[i].bob));
sprite[i].special.on:=FALSE;
END;
END;
DisplayBalls;
DisplayBalls;
SetDefault(n);
FOR i:=1 TO n DO
AddBob(ADR(sprite[i].bob),ADR(screenPtr^.rastPort));
END;
DisplayBalls;
DisplayBalls;
END SetTriangle;
PROCEDURE SetWithMouse;
VAR
intuiMessagePtr:IntuiMessagePtr;
gadgetPtr:GadgetPtr;
code:CARDINAL;
class:IDCMPFlagSet;
i,j:INTEGER;
xx,yy:INTEGER;
oldX,oldY:INTEGER;
dx,dy:LONGINT;
x,y:INTEGER;
overlap:BOOLEAN;
xf,yf:FFP;
BEGIN
SaveOldPosition;
i:=RemoveGList(windowPtr,ADR(gadget[1]),-1);
i:=AddGadget(windowPtr,ADR(gadget[2]),-1);
i:=BltBitMap(bitMapPtr[tag] ,0,ScreenHeight-GadgetHeight,
bitMapPtr[1-tag],0,ScreenHeight-GadgetHeight,
ScreenWidth,GadgetHeight,0C0H,255,NIL);
xf:=FFP(Frame*LocEx DIV 2);
yf:=2.0*FFP(Border);
i:=1;
FOR j:=1 TO MaxGels DO
IF i=(MaxGels DIV 2)+1 THEN
yf:=2.0*FFP(Border);
xf:=FFP(MaxX)-xf;
END;
IF NOT sprite[j].special.on THEN
INC(i);
PlaceBall(j,xf,yf,0.0,0.0);
AddBob(ADR(sprite[j].bob),ADR(screenPtr^.rastPort));
yf:=yf+FFP(BallDiameter+LocEx);
END;
END;
spriteCount:=MaxGels;
ballsOnTable:=MaxGels;
DisplayBalls;
DisplayBalls;
REPEAT
ModifyIDCMP(windowPtr,IDCMP);
WaitPort(windowPtr^.userPort);
intuiMessagePtr:=GetMsg(windowPtr^.userPort);
class:=intuiMessagePtr^.class;
code:= intuiMessagePtr^.code;
x:=intuiMessagePtr^.mouseX;
y:=intuiMessagePtr^.mouseY;
ReplyMsg(intuiMessagePtr);
IF (mouseButtons IN class) AND (code=selectDown) THEN
i:=FindNextBall(x,y);
IF i#0 THEN
oldX:=sprite[i].vSprite.x;
oldY:=sprite[i].vSprite.y;
ModifyIDCMP(windowPtr,IDCMPFlagSet{intuiTicks,mouseButtons});
REPEAT
WaitPort(windowPtr^.userPort);
intuiMessagePtr:=GetMsg(windowPtr^.userPort);
class:=intuiMessagePtr^.class;
code:= intuiMessagePtr^.code;
x:=intuiMessagePtr^.mouseX;
y:=intuiMessagePtr^.mouseY;
ReplyMsg(intuiMessagePtr);
j:=1;
overlap:=FALSE;
xx:=x*LocEx;
yy:=y*LocEx;
WHILE (j<=spriteCount) AND NOT overlap DO
IF sprite[j].special.on AND(j#i) THEN
dx:=xx-sprite[j].special.xi;
dy:=yy-sprite[j].special.yi;
overlap:=(dx*dx+dy*dy)<BallDiameter*BallDiameter;
END;
INC(j);
END;
IF NOT overlap THEN
oldX:=x;
oldY:=y;
sprite[i].vSprite.x:=x-(BallRadius DIV LocEx);
sprite[i].vSprite.y:=y-(BallRadius DIV LocEx);
tag:=1-tag;
screenPtr^.viewPort.rasInfo^.bitMap:=bitMapPtr[tag];
screenPtr^.rastPort.bitMap:=bitMapPtr[tag];
SortGList(ADR(screenPtr^.rastPort));
DrawGList(ADR(screenPtr^.rastPort),ADR(screenPtr^.viewPort));
MakeScreen(screenPtr);
RethinkDisplay();
END
UNTIL (mouseButtons IN class) AND (code=selectDown);
PlaceBall(i,FFP(oldX*LocEx),FFP(oldY*LocEx),0.0,0.0);
IF tag#Tag THEN
DisplayBalls
END;
END;
END;
UNTIL gadgetUp IN class;
i:=BltBitMap(bitMapPtr[tag] ,0,ScreenHeight-GadgetHeight,
bitMapPtr[1-tag],0,ScreenHeight-GadgetHeight,
ScreenWidth,GadgetHeight,0C0H,255,NIL);
i:=RemoveGadget(windowPtr,ADR(gadget[2]));
gadget[2].nextGadget:=ADR(gadget[3]);
i:=AddGList(windowPtr,ADR(gadget[1]),0,-1,NIL);
ModifyIDCMP(windowPtr,IDCMP);
FOR i:=1 TO MaxGels DO
WITH sprite[i].special DO
IF on THEN
IF (xi<LeftMost) OR (xi>RightMost) OR
(yi<TopMost) OR (yi>BottomMost) THEN
on:=FALSE;
RemBob(ADR(sprite[i].bob));
DEC(ballsOnTable);
ELSE
spriteCount:=i;
END;
END;
END
END;
DisplayBalls;
DisplayBalls;
END SetWithMouse;
PROCEDURE SetRND;
VAR
i,j:INTEGER;
x,y:INTEGER;
dx,dy:LONGINT;
overlap:BOOLEAN;
micros,secs:LONGINT;
BEGIN
SaveOldPosition;
CurrentTime(ADR(secs),ADR(micros));
PutSeed(ABS(secs+micros));
FOR i:=1 TO MaxGels DO
IF sprite[i].special.on THEN
RemBob(ADR(sprite[i].bob));
sprite[i].special.on:=FALSE;
END;
END;
DisplayBalls;
DisplayBalls;
i:=1;
WHILE i<=ballsOnTable DO
REPEAT
x:=RND(RightMost-LeftMost)+LeftMost;
y:=RND(BottomMost-TopMost)+TopMost;
overlap:=FALSE;
j:=1;
WHILE NOT overlap AND (j<i) DO
dx:=x-sprite[j].special.xi;
dy:=y-sprite[j].special.yi;
overlap:=(dx*dx+dy*dy)<BallDiameter*BallDiameter;
INC(j);
END;
UNTIL NOT overlap;
PlaceBall(i,FFP(x),FFP(y),0.0,0.0);
AddBob(ADR(sprite[i].bob),ADR(screenPtr^.rastPort));
Beep(borderSoundPtr,MaxVol);
DisplayBalls;
DisplayBalls;
Delay(10);
INC(i);
END;
END SetRND;
PROCEDURE SetFriction(more:BOOLEAN);
VAR
c:CHAR;
i:INTEGER;
BEGIN
IF more THEN
INC(maxTravels);
ELSE
DEC(maxTravels)
END;
maxTravels:=MaxInt(1,maxTravels);
maxTravels:=MinInt(9,maxTravels);
friction:=Friction/FFP(maxTravels);
c:=CHAR(maxTravels+INTEGER('0'));
FOR i:=0 TO 1 DO
tag:=1-tag;
screenPtr^.viewPort.rasInfo^.bitMap:=bitMapPtr[tag];
screenPtr^.rastPort.bitMap:=bitMapPtr[tag];
SetAPen(ADR(screenPtr^.rastPort),TextC);
SetBPen(ADR(screenPtr^.rastPort),TextBGC);
SetDrMd(ADR(screenPtr^.rastPort),jam2);
Move(ADR(screenPtr^.rastPort),gadgetXPos[9].x2+2,ScreenHeight-8);
Text(ADR(screenPtr^.rastPort),ADR(c),1);
END;
END SetFriction;
PROCEDURE Pool;
BEGIN
pool:=NOT pool;
DimOff(screenPtr,picInfo,1);
SetDrMd(ADR(screenPtr^.rastPort),jam2);
IF pool THEN
REPEAT
pool:=ReadBody(picName,bitMapPtr[tag]^,bodyPos,
picInfo.bmhd.width,
0,0,0,0,picInfo.bmhd.width,ScreenHeight-GadgetHeight,
MaskPlane(picInfo),(picInfo.bmhd.compression=1));
UNTIL pool OR NOT Requester(ADR('Billard:'),
ADR("Can't find picture 'BillardTable'"),
ADR('Try again'),ADR('Cancel'));
ScreenToFront(screenPtr);
ELSE
SetAPen(ADR(screenPtr^.rastPort),FrameC);
SetBPen(ADR(screenPtr^.rastPort),FrameC);
RectFill(ADR(screenPtr^.rastPort),0,0,
ScreenWidth-1,Frame-1);
RectFill(ADR(screenPtr^.rastPort),0,0,
Frame-1,ScreenHeight-1-GadgetHeight);
RectFill(ADR(screenPtr^.rastPort),0,ScreenHeight-1-GadgetHeight-Frame,
ScreenWidth-1,ScreenHeight-1-GadgetHeight);
RectFill(ADR(screenPtr^.rastPort),ScreenWidth-1-Frame,0,
ScreenWidth-1,ScreenHeight-1-GadgetHeight);
END;
SetAPen(ADR(screenPtr^.rastPort),GroundC);
SetBPen(ADR(screenPtr^.rastPort),GroundC);
RectFill(ADR(screenPtr^.rastPort),Frame,Frame,
ScreenWidth-1-Frame,ScreenHeight-1-Frame-GadgetHeight);
integer:=BltBitMap(bitMapPtr[tag],0,0,bitMapPtr[1-tag],0,0,ScreenWidth,
ScreenHeight-GadgetHeight,0C0H,255,NIL);
DimOn(screenPtr,picInfo,1);
DisplayBalls;
DisplayBalls;
END Pool;
BEGIN
SetTriangle(spriteCount);
SetFriction(TRUE);
SaveOldPosition;
integer:=AddGList(windowPtr,ADR(gadget[1]),0,-1,NIL);
LOOP
Info;
WaitPort(windowPtr^.userPort);
intuiMessagePtr:=GetMsg(windowPtr^.userPort);
class:=intuiMessagePtr^.class;
code:= intuiMessagePtr^.code;
IF (mouseButtons IN class) AND (code=selectDown) THEN
i:=FindNextBall(intuiMessagePtr^.mouseX,intuiMessagePtr^.mouseY);
ReplyMsg(intuiMessagePtr);
IF i#0 THEN
integer:=RemoveGList(windowPtr,ADR(gadget[1]),-1);
SaveOldPosition;
SetBall(i);
ModifyIDCMP(windowPtr,IDCMPFlagSet{});
StartControl;
REPEAT
DisplayBalls;
UNTIL noBallMoved AND (tag=Tag);
EndControl;
DisplayBalls;
DisplayBalls;
ModifyIDCMP(windowPtr,IDCMP);
integer:=AddGList(windowPtr,ADR(gadget[1]),0,-1,NIL);
player:=1-player;
END;
ELSIF (mouseButtons IN class) AND (code=menuDown) THEN
ScreenToBack(screenPtr)
ELSIF gadgetUp IN class THEN
gadgetPtr:=intuiMessagePtr^.iAddress;
i:=gadgetPtr^.gadgetID;
ReplyMsg(intuiMessagePtr);
CASE i OF
|1:EXIT;
|2:SetWithMouse;
|3:SetTriangle(0);
|4:SetTriangle(7);
|5:SetTriangle(11);
|6:SetTriangle(16);
|7:SetRND;
|8:MorePower;
|9:SetFriction(FALSE);
|10:SetFriction(TRUE);
|11:BallNumbers;
|12:Pool;
|13:Undo;
ELSE
END;
END;
END;
END GetMessage;
(***************************************************************************)
BEGIN
(*startLevel:=CurrentLevel();*)
InitAll;
GetMessage;
END Billard.